home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / surfsrc3.zip / STORSHAD.INC < prev    next >
Text File  |  1989-08-10  |  2KB  |  74 lines
  1. procedure STORSHADES (X1, Y1, X2, Y2: integer; Shade1, Shade2: real;
  2.     var Xpt, Ypt: points; var Shpt: realpts; var Npts: integer);
  3.  
  4. { Store the line from (X1,Y1) to (X2,Y2) in an internal buffer with
  5.   interpolated shading from Shade1 to Shade2 }
  6.  
  7. var X, Y: integer;                   { current point being stored }
  8.     Xfact: real;                     { factor for (X,Y) interpolation }
  9.     Shfact: real;                    { factor for shade interpolation }
  10.     Ylow, Yhigh: integer;            { range of for loop }
  11.     Firstx: boolean;                 { flag first dot of line }
  12.     Firstsh: boolean;                { flag first shade of line }
  13.     Shade: real;                     { shade at each pixel }
  14.  
  15. begin
  16.   Firstx := TRUE;
  17.   Firstsh := TRUE;
  18.   if (Y2 = Y1) then
  19.     Xfact := 0.0
  20.   else
  21.     Xfact := (X2-X1) / (Y2-Y1);
  22.   if (Y1 > Y2) then begin
  23.     Ylow := Y2;
  24.     Yhigh := Y1;
  25.   end else begin
  26.     Ylow := Y1;
  27.     Yhigh := Y2;
  28.   end;
  29.   if (Ylow < Gymin) then
  30.     Ylow := Gymin;
  31.   if (Yhigh > Gymax) then
  32.     Yhigh := Gymax;
  33.   if (Y1 = Y2) then
  34.     Shfact := 0.0
  35.   else
  36.     Shfact := (Shade2 - Shade1) / (Y2 - Y1);
  37.  
  38. { Store the line segment, making sure there is not more than one X
  39.   value for any given Y (unless Y1 = Y2, in which case only the two
  40.   endpoints should be saved).
  41. }
  42. { Make sure the entire line isn't out of bounds }
  43.   if (Ylow <= Gymax) and (Yhigh >= Gymin) then begin
  44.     for Y := Ylow to Yhigh do begin
  45.       if (Xfact = 0.0) then
  46.         if (Firstx) then begin
  47.           X := X1;
  48.           Firstx := FALSE;
  49.         end else
  50.           X := X2
  51.       else
  52.         X := X1 + round((Y-Y1) * Xfact);
  53.       if (Shfact = 0.0) then
  54.         if (Firstsh) then begin
  55.           Shade := Shade1;
  56.           Firstsh := FALSE;
  57.         end else
  58.           Shade := Shade2
  59.       else
  60.         Shade := Shade1 + (Y - Y1) * Shfact;
  61.       Npts := Npts + 1;
  62.       if (Npts <= MAXPTS) then begin
  63.         Xpt[Npts] := X;
  64.         Ypt[Npts] := Y;
  65.         Shpt[Npts] := Shade;
  66.       end;
  67.     end;  { for Y }
  68.   end; { if Ylow... }
  69.  
  70. { Flag error condition if array dimension exceeded }
  71.   if (Npts > MAXPTS) then
  72.     Npts := -1;
  73. end;  { procedure STORSHADES }
  74.